home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Libris Britannia 4
/
science library(b).zip
/
science library(b)
/
PROGRAMM
/
DB_CLIPP
/
1989.ZIP
/
QQDMEDIT.PRG
< prev
next >
Wrap
Text File
|
1990-05-19
|
6KB
|
209 lines
* QQDMEDIT.PRG simple program to customize QDM files
* Use this program to modify existing QDM files. You will be using a Fox
* text editor to make changes:
* Modify the default field names pop up menu title
* Change the content of any field name line
* Add new lines
* Delete existing lines
* Add new children files and fields
* Blank lines will be ignored
* Restrictions:
* The 1st 10 characters of each field line is reserved for the field name
* The 1st 2 characters of each child alias line is reserved for 2 periods (..)
* The next 8 characters of each child alias line is reserved for the alias name
* Any lines longer than 49 charcters will be truncated.
*
* NOTE: This program uses the FoxPro MODIFY COMMAND editor to change
* existing data. This program expects a backup file to be created whenever
* a file is changed by MODIFY COMMAND. If FoxPro is not configured to make
* a backup, this program will not record any changes to your QDM files.
*
* To check your current FOXPRO configuration:
*
* 1. Start this progran and enter a QDM file name.
* 2. At the editing window, invoke the FoxPro main menu (F10 key).
* 3. Select the Edit menu.
* 4. Select the "Preferences" dialog.
* 5. If the option "Make backup" is not selected:
* a. Select "Make backup"
* b. Select "Use these preferences as default for .TXT files"
* c. Save the dialog << OK >>
* set the environment
SET CONFIRM ON
SET DELETED ON
SET EXACT OFF
SET SAFE OFF
SET STATUS ON
SET TALK OFF
CLEAR ALL
changing=.t.
* display any QDM files
CLEAR
qqbanner=REPL(CHR(178),31)+' Q Q U E R Y (tm) '+REPL(CHR(178),31)
@ 0,0 GET qqbanner
CLEAR GETS
? 'QDM files in the current directory:'
?
DIR *.qdm
?
?
qqrow=ROW()
* get the name of a QDM file to work with
DO WHILE TYPE('qqfieldsct')='U' .AND. changing
@ qqrow,0 SAY 'Enter a QDM file name to change (without the QDM extension), OR,'
?
ACCEPT 'to cancel this process, just strike the Enter key: ' TO qqdmfile
IF LEN(TRIM(qqdmfile))=0
changing=.f.
ELSE
qqdmfile=qqdmfile+'.qdm'
* just beep on any error (file does not exist, etc.)
ON ERROR ?? chr(7)
RESTORE FROM &qqdmfile ADDITIVE
ON ERROR
@ qqrow,0 CLEAR TO 21,79
@ 1,0 SAY ''
ENDIF
ENDDO
IF changing
@ 1,0 CLEAR TO 21,79
@ 2,0 SAY 'Preparing text file for editing . . . '
?
children=qqfielchil
file=0
tempname=SYS(3)
temptxt=tempname+'.TXT'
tempbak=tempname+'.BAK'
* copy the existing QDM to an ASCII text file
SET PRINTER TO &temptxt
SET PRINT ON
SET CONSOLE OFF
qqstndtitl=" Type Width Dec═╦══════ Sample ═════"
IF TYPE('qqfieltitl')='U'
qqfieltitl=qqstndtitl
ENDIF
?? "<alias> "+qqfieltitl
?
DO WHILE file<=children
IF file=0
items=qqfieldsct
qqarray='qqfields'
ELSE
qqchildnum=right(str(file+100,3),2)
qqcount='qqfielct'+qqchildnum
qqarray='qqfielar'+qqchildnum
qqcname='qqfielnm'+qqchildnum
?? '..'+&qqcname+REPL('.',39)
?
items=&qqcount
ENDIF
element=1
DO WHILE element<=items
?? &qqarray.(element)
?
element=element+1
ENDDO
file=file+1
ENDDO
SET CONSOLE ON
SET PRINT OFF
SET PRINTER TO PRN
@ 1,0 CLEAR TO 21,79
@ 1,0 SAY ''
* Edit the ASCII text version of the QDM file
IF AT('FOXPRO',UPPER(VERSION())) <> 0
DEFINE WINDOW EDITR FROM 2,12 TO 20,64 DOUBLE SHADOW
MODI FILE &temptxt WINDOW EDITR
ELSE
MODI COMM &temptxt
ENDIF
@ 0,0 GET qqbanner
CLEAR GETS
* Saved changes indicated by creation of BAK file
changing=FILE ('&tempbak')
IF changing
DELETE FILE &tempbak
ACCEPT 'CONFIRM: Replace existing QDM file? (Yes/No) ' TO choice
changing=UPPER(choice)='Y'
ENDIF
IF .NOT. changing
@ 1,0 CLEAR TO 21,79
@ 2,0 SAY 'QDM file not changed.'
DELETE FILE &temptxt
ENDIF
ENDIF
IF changing
* Create a temporary DBF
tempdbf=SYS(3)
CLEAR TYPEAHEAD
KEYBOARD 'qdmdata'+CHR(13)+'C49'+CHR(13)+CHR(13)+CHR(13)+'N'
CREATE &tempdbf
@ 0,0 GET qqbanner
CLEAR GETS
@ 1,0 CLEAR TO 21,79
@ 2,0 SAY 'Creating new arrays . . . '
?
* Fill the DBF with the contents of the modified ASCII text file
APPEND FROM &temptxt SDF
* delete the ASCII text file
DELETE FILE &temptxt
* delete any blank lines in the DBF
DELETE FOR LEN(TRIM(qdmdata))=0
GO TOP
* release existing QDM variables
RELEASE ALL LIKE QQFIEL*
* create a custom pop up window title variable if the title was changed
IF SUBSTR(qdmdata,11)<>qqstndtitl
qqfieltitl=SUBSTR(qdmdata,11,38)
ENDIF
* point past the title, to the first field of the master file
SKIP
file=0
qqarray='qqfields'
current=recno()
COUNT WHILE qdmdata<>'..' .AND. .NOT. EOF() TO qqfieldsct
goto current
DIMENSION qqfields(qqfieldsct)
element=1
? '<MAIN>'
DO WHILE .NOT. EOF()
DO CASE
CASE qdmdata='..'
file=file+1
qqchildnum=right(str(file+100,3),2)
qqcount='qqfielct'+qqchildnum
qqarray='qqfielar'+qqchildnum
qqcname='qqfielnm'+qqchildnum
? LOWER(SUBSTR(qdmdata,3,8))
&qqcname.=SUBSTR(qdmdata,3,8)
current=recno()
SKIP
COUNT WHILE qdmdata<>'..' .AND. .NOT. EOF() TO &qqcount
goto current
DIMENSION &qqarray.(&qqcount)
element=0
OTHERWISE
&qqarray.(element)=TRIM(qdmdata)
ENDCASE
SKIP
element=element+1
ENDDO
USE
IF file>0
qqfielchil=file
ENDIF
* save the new QDM
SAVE TO &qqdmfile ALL LIKE qqfiel*
* delete the temporay DBF
tempdbf=tempdbf+'.dbf'
DELE FILE &tempdbf
?
? 'New QDM saved.'
ENDIF
SET TALK ON
SET SAFE ON
RETURN